home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 1463.ZIP / DRAW-2D.ARC / SAVEFILE.PAS < prev    next >
Pascal/Delphi Source File  |  1986-11-17  |  1KB  |  37 lines
  1.    PROCEDURE SAVEFILE;
  2.       VAR
  3.         FLAG:BOOLEAN;
  4.         T:CHAR;
  5.         FNAME:STR8;
  6.         DSTR,MSG:SCRLINE;
  7.         K:INTEGER;
  8.         FX:STR12;
  9.         J:INTEGER;
  10.       BEGIN
  11.           FLAG := TRUE;
  12.           WHILE FLAG DO
  13.                 BEGIN
  14.                  FLAG := FALSE;
  15.                  J := POS('.',DFILE);
  16.                  FNAME := COPY(DFILE,1,J-1);
  17.                  MSG := 'Enter Drawing File Name for Save <' + FNAME + '>: ';
  18.                  DSTR := ASKSTR(24,2,1,MSG,' ',' ',FNAME);
  19.                  J := POS('.',DSTR);
  20.                  IF J <> 0 THEN DSTR := COPY(DSTR,1,J-1);
  21.                  IF (LENGTH(DSTR) > 8) THEN FX := COPY(DSTR,1,8) + TP
  22.                       ELSE FX := DSTR + TP;
  23.                  ASSIGN(DRAWFIL,FX);
  24.                  {$I-}
  25.                  RESET(DRAWFIL);
  26.                  {$I+}
  27.                  K := IORESULT;
  28.                  CLOSE(DRAWFIL);
  29.                  IF K <> 0 THEN SAVEDR(FX)     (* FILE NOT FOUND *)
  30.                     ELSE
  31.                      BEGIN
  32.                        MSG := 'File already exists -- Overwrite (Y/N) <Y> ?';
  33.                        T := ASKCHAR(24,2,1,MSG,' ',' ','Y');
  34.                        IF T <> 'N' THEN SAVEDR(FX) ELSE FLAG := TRUE;
  35.                      END;
  36.                 END;   (* WHILE *)
  37.       END;